home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / sound / sample20.zip / SAMPLER.INC < prev    next >
Text File  |  1989-05-04  |  43KB  |  1,451 lines
  1.  
  2. { Utility procedures for sampler.pas}
  3.  
  4.  
  5. {$f+}
  6. procedure samplerexit; {$f-}
  7.  
  8. { incase graphics mode, restore text screen before error message is given
  9.   also restores keyboard interrupt on abort}
  10.  
  11. begin {samplerexit}
  12. mem[0 : $417] := mem[0 : $417] And $fc; {shift off}
  13. restorecrtmode;
  14. exitproc:=exitsave;
  15. if showerrormessage then
  16.   writeln('Exit due to internal error!');
  17. if customkbd then
  18.   restore;
  19. end; {samplerexit}
  20.  
  21.  
  22. function index(position:longint):longint;
  23.  
  24. { calculates buffer array index for given screen position}
  25.  
  26. begin {index}
  27. if zoom then
  28.   index:=viewleft+position - plotxoffset
  29. else
  30.   index:=Round((position - plotxoffset)
  31.          / (getmaxx - 2 * plotxoffset) * bufflength);
  32. end;{index}
  33.  
  34. function scaleord(index:longint):integer;
  35.  
  36. { calculates screen position for indexth position in buffer array}
  37.  
  38. begin {scaleord}
  39. if zoom then
  40.   scaleord:=index-viewleft+plotxoffset
  41. else
  42.   scaleord:= Round(index / bufflength * (getmaxx - 2 * plotxoffset)
  43.                    + plotxoffset); {move to end of read data}
  44. end; {scaleord}
  45.  
  46.  
  47.   Function keypress : Boolean;
  48.  
  49.     { assumes custom keyboard service is installed. checks if a key has been
  50.     pressed and released}
  51.  
  52.   Begin
  53.     If kbdflag > 0 Then
  54.       Case keyval Of
  55.         42 : mem[0 : $417] := mem[0 : $417] Or 2; {lshift down}
  56.         54 : mem[0 : $417] := mem[0 : $417] Or 1; {rshift down}
  57.         170 : mem[0 : $417] := mem[0 : $417] And $fd; {lshift release}
  58.         182 : mem[0 : $417] := mem[0 : $417] And $fe; {rshift release}
  59.       End;                        {case}
  60.     keypress := (kbdflag > 0) And (keyval < 128);
  61.   End;  {keypress}
  62.  
  63.  
  64.  
  65.   Function get_inc(tune : Integer; c : Char) : Integer;
  66.  
  67.     { returns a fractional increment value for a given key based on 12th root
  68.       of 2}
  69.  
  70.   Begin
  71.     get_inc := Round(tune * Exp(kbdmap[c] * 0.057762265));
  72.                             {= (12th root of 2)^kbdmap[c] * tune}
  73.   End;   {get_inc}
  74.  
  75.  
  76.   Procedure display_title(title_string:string; font, fontsize,
  77.                           bcolor,color:word);
  78.  
  79.     { displays nice big bold title}
  80.  
  81.   Begin
  82.     settextstyle(font, horizdir, fontsize);
  83.     settextjustify(centertext, toptext);
  84.     panel(getmaxx Div 2, 1, getmaxx-cornersize*2, Round(textheight(titlestring) * 1.1),
  85.       bcolor);
  86.     selectcolor(color);
  87.     outtextxy(getmaxx Div 2, - 4, title_string);
  88.   End;   {display_title}
  89.  
  90.  
  91.   Procedure display_pointers(leftord,rightord,loopord:longint;
  92.                              leftshow,rightshow,loopshow:boolean);
  93.  
  94.     { displays up to 3 pointers}
  95.  
  96.   Begin
  97.     if leftshow and (leftord>=viewleft) and (leftord<=viewright) then
  98.       putimage(scaleord(leftord) - arrowxoff, arrowlowy, uparrowp^, xorput);
  99.     if rightshow and (rightord<=viewright) and (rightord<=viewright) then
  100.       putimage(scaleord(rightord) - arrowxoff, arrowlowy, uparrowp^, xorput);
  101.     if loopshow and (loopord>=viewleft) and (loopord<=viewright) then
  102.       putimage(scaleord(loopord) - arrowxoff, arrowhighy, downarrowp^, xorput);
  103.   End;                            {display_pointers}
  104.  
  105.  
  106.   Procedure highlight_directory_entry(fileno : Integer; extension:boolean;
  107.                                       highlight : Boolean);
  108.  
  109.     { highlights the currently selected file or restores if highlight=false
  110.       if extension=true then the file extension is shown also}
  111.  
  112.   Var j, x, y : Integer;
  113.     str1 : String;
  114.  
  115.   Begin
  116.     settextstyle(smallfont, horizdir, 4);
  117.     settextjustify(lefttext, toptext);
  118.     str1:=copy(bigemptystring,1,dirnamefieldwidth);
  119.     j := pos('.', dir[fileno]);
  120.     if extension or (j=0) then
  121.        j:=succ(length(dir[fileno]));
  122.     If highlight Then
  123.       Begin
  124.         selectcolor(dirhcolor);
  125.         selectfillstyle(solidfill, dircolor);
  126.       End
  127.     Else
  128.       Begin
  129.         selectcolor(dircolor);
  130.         selectfillstyle(solidfill, dirbcolor);
  131.       End;
  132.     x := cornersize
  133.          + (Pred(fileno) Mod dirnamesperline) * textwidth(str1);
  134.     y := directoryyoff
  135.          + Pred(fileno) Div dirnamesperline * textheight(' ');
  136.     bar(x, y+1, x + textwidth(Copy(str1, 1, 8)),
  137.         y + textheight(' ') );
  138.     outtextxy(x, y, Copy(dir[fileno], 1, Pred(j)));
  139.   End;  {highlight_directory_entry}
  140.  
  141.  
  142.   Procedure getdirectory(Var dir : directory_type; pattern : String);
  143.  
  144.     {read file names in current directory matching pattern to dir}
  145.  
  146.   Var dirinfo : searchrec;
  147.     fileno,i : Integer;
  148.  
  149.   Begin
  150.     findfirst(path+'\'+pattern, 0, dirinfo);
  151.     fileno := 1;
  152.     While doserror = 0 Do
  153.       Begin
  154.         dir[fileno] := dirinfo.name;
  155.         i:=pos('.',dir[fileno]);
  156.         if i in [1..8] then
  157.           dir[fileno]:=copy(copy(dir[fileno],1,pred(i))+'        ',1,8)+
  158.                        copy(dir[fileno],i,4);    {right justify extension}
  159.         Inc(fileno);
  160.         findnext(dirinfo);
  161.       End;
  162.     dir[fileno] := '';            {mark end of list}
  163.   End; {getdirectory}
  164.  
  165.  
  166.   Procedure showdirectory(extension:string);
  167.  
  168.     { displays files with extension in current directory}
  169.  
  170.  
  171.   var i,j,k:integer;
  172.  
  173.   Begin
  174.     settextstyle(smallfont, horizdir, 5);
  175.     settextjustify(lefttext, toptext);
  176.     fill_background(dirbcolor,solidfill,cornersize);
  177.     selectcolor(dircolor);
  178.     getdirectory(dir, '*.'+extension);
  179.     if extension='*' then
  180.       extension:='All';
  181.     outtextxy(cornersize, 0, extension+' files on  ' +
  182.               path);
  183.     directoryyoff:=round(textheight(' ')*1.3);
  184.     i := 1;
  185.     While (dir[i]<>'') and (dir[Succ(i)] <> '') Do   {sort dir}
  186.       Begin
  187.         j := Succ(i);
  188.         While dir[j] <> '' Do
  189.           Begin
  190.             If dir[j] < dir[i] Then {name out of sequence}
  191.               Begin
  192.                 str1 := dir[j];
  193.                 For k := Pred(j) Downto i Do {shift names down list}
  194.                   dir[Succ(k)] := dir[k];
  195.                 dir[i] := str1;   {insert name in correct place}
  196.               End;
  197.             j := Succ(j);
  198.           End;
  199.         i := Succ(i);
  200.       End;
  201.     str1 := '';
  202.     For i := 1 To dirnamefieldwidth Do
  203.       str1 := str1 + ' ';
  204.     i := 1;
  205.     While dir[i] <> '' Do
  206.       Begin
  207.         highlight_directory_entry(i, (extension='All'),False);
  208.         i := Succ(i);
  209.       End;
  210.     filesavail := Pred(i);
  211.     settextstyle(smallfont, horizdir, 4);
  212.     settextjustify(lefttext, toptext);
  213.     Str(diskfree(0) shr 10, str1);
  214.     outtextxy(cornersize,
  215.               directoryyoff+(filesavail div dirnamesperline +1)
  216.               *textheight(' '),' With ' + str1 + ' k free');
  217.   End;  {showdirectory}
  218.  
  219.  
  220.   procedure pickfile(extension:string; var pick:string);
  221.  
  222.   { shows directory list, then allows file selection by mouse or naming
  223.    specifically}
  224.  
  225.   var j:integer;
  226.       c:char;
  227.       cp:clickboxtypep;
  228.       dp:dialogentryp;
  229.       manual:boolean;
  230.  
  231.   function strip(s:string):string;
  232.  
  233.   { strips spaces from string and converts to lower case}
  234.  
  235.   var i:integer;
  236.  
  237.   begin
  238.   i:=pos(' ',s);
  239.   while i>0 do
  240.   begin
  241.     delete(s,i,1);
  242.     i:=pos(' ',s);
  243.   end;
  244.   for i:=1 to length(s) do
  245.     if s[i] in ['A'..'Z'] then
  246.       s[i]:=chr(ord(s[i])+ord('a')-ord('A'));
  247.   strip:=s;
  248.   end; {strip}
  249.  
  250. function selection:integer;
  251.  
  252. { determines which (if any) file bar was selected}
  253.  
  254. var boxwidth,boxheight,sel:integer;
  255.  
  256. begin {selection}
  257. boxwidth:=textwidth(copy(bigemptystring,1,dirnamefieldwidth));
  258. boxheight:=textheight(' ');
  259. if   (mousex>cornersize) and
  260.      (mousex-cornersize<boxwidth*dirnamesperline) and
  261.      ((mousex -cornersize) mod boxwidth
  262.       < textwidth(copy(bigemptystring,1,8))) and
  263.      (mousey>directoryyoff) and
  264.      (mousey-directoryyoff
  265.       <(pred(filesavail) div dirnamesperline +1)*boxheight) then
  266. begin
  267.   sel:=(mousex-cornersize) div boxwidth +
  268.        ((mousey-directoryyoff) div boxheight )*dirnamesperline+1;
  269.   if sel>filesavail then
  270.     selection:=-1
  271.   else
  272.     selection:=sel;
  273. end
  274. else
  275.   selection:=-1;
  276. end; {selection}
  277.  
  278.  
  279.   begin {pickfile}
  280.     mousearrowoff;
  281.     showdirectory(extension);
  282.     settextstyle(defaultfont,horizdir,1);
  283.     selectcolor(dialogco